#!/usr/bin/perl -w # for syntax highlighting
package clreqd_modules;

use XML::Parser;
use Data::Dumper;
use nethardware;		# Network probing routines
use Sys::Hostname;

use strict;

# Dynamic Features
# ================
# If the network daemon is currently running a reconfiguration message will
# be sent to ensure that any changes are picked up after loading them.
#
# Checks
# ======
# If a topology is already defined and the new reloaded one uses less
# cards then a check will be made to see if any IP's are associated
# with the card at present [physical and logical interfaces]. If so 
# the changes will abort since it is likely that an application is
# still using the interface.
#
# If an attempt is made to remove a topology a check is made to see 
# if any applications are currently making use of that topology
# and if so an error will be given.
#

my $error_str;
my $top_config;

sub load_topology {
my %ARGS=@_;
my $file;
my $force=0;

	$error_str=undef;
	$top_config={};
	if(exists($ARGS{FORCE})) {
		$force=1 if $ARGS{FORCE} =~ /^(y|yes|1|true)/i;
	}
	if(!exists($ARGS{RELOAD})) { $ARGS{RELOAD}=0; }
	if(exists($ARGS{FILE})) {
		$file=$ARGS{FILE};
	} else {
		$file="$::ENV{TRUECL_CFG}/topology.xml" if !defined($file);
	}
	if(! -e $file) {
		return "FAIL Topology file '$file' does not exist.";
	}
	if(! -f $file) {
		return "FAIL Toplogy file '$file' is not a regular file.";
	}

	#################################################################
	# Check the database exists, and abort if not - otherwise open.	#
	#################################################################

	if(! -f "$::ENV{TRUECL_CFG}/config.db") {
		return("FAIL Configuration database '$::ENV{TRUECL_CFG}/config.db' does not exist.");
	}

	my $db=new cldb("$::ENV{TRUECL_CFG}/config.db");
	if(!defined($db)) {
		return("FAIL Unable to open database:\n" . cldb::error);
	}
	::msg("Opened database connection to '$::ENV{TRUECL_CFG}/config.db'.");

	#################################################################
	# Ensure the table exists and abort if not.			#
	#################################################################

	if(! $db->exists("table","topology")) {
		return("FAIL Config database missing 'topology' table.");
	}
	
	#################################################################
	# Get a count of the port entries and if >0 then abort unless	#
	# the rescan option has been chosen.				#
	#################################################################

	my $href=$db->get_rows("SELECT COUNT(*) as count FROM topology");
	my $top_details={};
	if(!defined($href)) {
		return "FAIL Error occurred running SQL statement!";
	}
	my $count=int($href->[0]->{count});
	my $hostname=hostname;
	if($count>0) {
		if($ARGS{RELOAD}==0) {
			return "FAIL Table 'topology' is populated already - and no 'reload' option given.";
		}

		#########################################################
		# We need to get all topology details so we can perform	#
		# yet more checks.					#
		#########################################################
		my $href2=$db->get_rows("SELECT * FROM topology");
		if(defined($href2->[0]->{name})) {
			for my $crec (@$href2) {
				next if !defined($crec->{name});
				my @pcards=();
				my @lcards=();
				$top_details->{$crec->{name}}={};
				if(defined($crec->{pcards})) {
					$top_details->{$crec->{name}}->{pcards}=[split(/,/,$crec->{pcards})];
				}
				if(defined($crec->{lcards})) {
					$top_details->{$crec->{name}}->{lcards}=[split(/,/,$crec->{lcards})];
				}
			}
		}
	}

	my $netconfig=new nethardware;
	if(!defined($netconfig)) {
		return "FAIL Unable to query network topology!";
	}

	#################################################################
	# Now load in the XML using the XML::Parser - not XML simple.	#
	#################################################################
	
	my $p;
	$p = new XML::Parser(
			Handlers => { Start => \&top_handle_start },
			ErrorContext => 5
			);
	$p->parsefile($file);
	if(defined($error_str)) {
		return "FAIL $error_str";
	}

	#################################################################
	# The variable $top_config contains a hash of the data in the	#
	# following format:						#
	# network => {cards => ..., attributes => ...}			#
	#################################################################

	my $cnet;
	my %cards=();
	my @E=();
	my @W=();
	#################################################################
	# Work out to see if any topologies have been removed 		#
	# completely and keep a list of them if so.			#
	#################################################################

	my @gone_away=();
	for my $cc (keys %$top_details) {
		if(! exists($top_config->{$cc})) {
			push @gone_away,$cc;
		}
	}

	#################################################################
	# If any entries in gone-away we deal with them now.		#
	#################################################################

	if(@gone_away) {
		::msg("Attempting to remove following topologies:");
		::msg("* $_") foreach(@gone_away);

		for my $cnet (@gone_away) {
			my $href3=$db->get_rows("SELECT name FROM application_ips where network = '$cnet';");
			for my $cref (@$href3) {
				if(defined($cref->{name})) {
					my $app=$cref->{name};
					my $href4=$db->get_rows("SELECT * from applications where name = '$app';");
					if($href4 && $href4->[0]->{nodes}) {
						my @N=split(/,/, $href4->[0]->{nodes});
						if(grep {$_ eq $hostname} @N) {
							push @E,"Network '$cnet' is defined for use with application '$cref->{name}' on host '$hostname'.";
						}
					}
				}
			}
		}
	}
	if(@E) {
		return "FAIL The following errors have occurred:\n" . join("\n",@E) ;
	}

	for $cnet (sort(keys(%$top_config))) {
		my @clist=split(/,/,$top_config->{$cnet}->{cards});
		if(! @clist) {
			push @E,"Network '$cnet' does not define any cards.";
			next;
		}
		#########################################################
		# If the topology refers to an existing entry that we	#
		# are changing check to see if the new version has any	#
		# less cards in it.					#
		#########################################################
		if(defined($top_details) && exists($top_details->{$cnet})) {
			my @removed=();
			for my $cc (@{$top_details->{$cnet}->{lcards}}) {
				if(! grep {$cc eq $_} @clist) {
					push @removed,$cc;
				}
			}
			#################################################
			# If cards are being removed then validate no	#
			# IP addresses are currently associated, and if	#
			# so then abort the remove.			#
			#################################################
			if(@removed) {
				::msg("Attempting to remove the following cards from the network '$cnet':");
				::msg("* $_") for (@removed);
			}
			for (@removed) {
				my $cref=$netconfig->cardref($_);
				if(defined($cref->{IPv4}) && $cref->{IPv4} ne "") {
					push @E,"Unable to remove card '$_' from network '$cnet' - IP address defined on it.";
				}
			}
		}
		if(@E) {
			return "FAIL The following errors have occurred:\n" . join("\n",@E) ;
		}

		#################################################################
		# Look for unknown cards, or multiple IP address. Multiple	#
		# IP addresses can be allowed only if all cards in the topology	#
		# are classed as aggregated.					#
		#################################################################
		my $hadip=undef;
		my $aggr_count=0;
		for (@clist) {
			my $cref=$netconfig->cardref($_);
			if(!defined($cref)) {
				push @E,"Card '$_' is unknown on host.";
				next;
			}
			if($netconfig->is_aggr($_)) {
				$aggr_count++;
				if(defined($cref->{IPv4}) && $cref->{IPv4} ne "") {
					$hadip=$_;
				}
				next;
			}

			if(defined($cref->{IPv4}) && $cref->{IPv4} ne "") {
				if(defined($hadip)) {
					push @E,"Card '$hadip' already defined IP for network '$cnet' - but card '$_' also has one!";
					next;
				}
				$hadip=$_;
			}
		}
		if(!defined($hadip)) {
			if($force) {
				push @W,"Network '$cnet' does not define an IP address.";
			} else {
				push @E,"Network '$cnet' does not define an IP address.";
			}
		}
	}
	if(@E) {
		return "FAIL The following errors have occurred:\n" . join("\n",@E) ;
	}
	if(@W) {
		::warning($_) foreach(@W);
	}

	#################################################################
	# The network topology is OK - so the next step is to load 	#
	# into database.						#
	# Remove any existing topolgy records - will check args to 	#
	# allow this before anyway.					#
	#################################################################

	if($count>0) {
		::msg("Temporarily clearing down 'topology' table.");
		$db->do("DELETE FROM topology");
	}
	my @pcards=();
	my $ccard;
	for $cnet (sort(keys(%$top_config))) {
		my @clist=split(/,/,$top_config->{$cnet}->{cards});
		@pcards=();
		for $ccard  (@clist) {
			::msg("Checking card details for '$ccard'.");
			my $cref=$netconfig->cardref($ccard);
			if(exists($cref->{HW}) && defined($cref->{HW})) {
				push @pcards,"$cref->{HW}";
			} else {
				push @pcards,"??";
			}
		}
		my $cmd="INSERT INTO topology (name,lcards,pcards,type,attributes) VALUES(";
		$cmd.="'$cnet','" . $top_config->{$cnet}->{cards} . "','"; 
		$cmd.=join(",",@pcards) . "','failover','');";
		if(!$db->do($cmd)) {
			::error("Failed to instert record into 'topology' table:");
			::error($cmd);
			return "FAIL Insert into 'topology' table failed:\n" . ($db->error)[1];
		} else {
			::msg("Successfully insert topology record for '$cnet'.");
		}
	}
	$db=undef;

	#################################################################
	# If we have access to the daemon_reconfigure routine then call	#
	# it to force the reconfiguration if the daemon is running.	#
	#################################################################

	if(defined(&daemon_reconfigure)) {
		daemon_reconfigure(DAEMON=>"netd",TIMEOUT=>3);
	}
	return "OK";
}

sub top_handle_start {
my $parser=shift;
my $element=shift;
my %attrs=(@_);
my @context=$parser->context;
my $data;
my @missing=();

	$element=uc($element);

	return if $element eq "TOPOLOGY";
	if($element eq "NETWORK") {
		if(!exists($attrs{name})) { push @missing,"name"; }
		if(!exists($attrs{cards})) { push @missing,"cards"; }
		if(@missing) {
			$error_str="'Network' element missing mandatory attributes: " . join(",",@missing);
			$parser->xpcroak("'Network' element missing mandatory attributes: " . join(",",@missing));
		}
		my $name=$attrs{name};
		$top_config->{$name}={};
		for ("cards","attributes") {
			if(exists($attrs{$_})) {
				$top_config->{$name}->{$_}=$attrs{$_};
			} else {
				$top_config->{$name}->{$_}="";
			}
		}
		return;
	}
	$error_str="Unrecognised element '$element'.";
	$parser->xpcroak("Unrecognised element '$element'.");
}

1;
